R Notebook

library(tsibbledata)
library(tidyverse)

Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ──────────────────────────────────────────────── tidyverse 1.3.2 ──✔ ggplot2 3.3.6     ✔ purrr   0.3.4
✔ tibble  3.1.8     ✔ dplyr   1.0.9
✔ tidyr   1.2.0     ✔ stringr 1.4.0
✔ readr   2.1.2     ✔ forcats 0.5.1── Conflicts ─────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

library(lubridate)

Attaching package: ‘lubridate’

The following objects are masked from ‘package:base’:

    date, intersect, setdiff, union

library(tsibble)

Attaching package: ‘tsibble’

The following object is masked from ‘package:lubridate’:

    interval

The following objects are masked from ‘package:base’:

    intersect, setdiff, union

nyc_bikes_df <- nyc_bikes

What is the pattern of bike hires over time (e.g. within a year, month, week, or day)? Do bike hire patterns differ between bike rider demographics? (e.g. gender, type of trip, age) Any other insights?

You will probably want to use the data in column start_time to create date, month and year columns. Summarising the data by aggregating hire counts by different measures of time (e.g. year, quarter, month, day) and then visualising the results is probably a good idea When grouping time series data (tsibble), you need to use index_by instead of group_by

nyc_bikes_short <- nyc_bikes_df %>% 
  select(start_time, stop_time, birth_year, gender, type) %>% 
  mutate(year = year(start_time),
         month = month(start_time, label = TRUE),
         day = as.Date(start_time),
         wday  = wday(start_time,label = TRUE),
         week = week(start_time),
         time_ride = stop_time - start_time,
         age = as.numeric(year - birth_year))
nyc_bikes_short

year/month/week/day pattern

bike_year <-nyc_bikes_short%>%
  index_by(year) %>%
  summarise(p90 = quantile(time_ride, probs=0.9, na.rm=TRUE))
bike_year

 nyc_bikes_short %>% 
  mutate(time_ride = as.numeric(time_ride)) %>% 
  filter(time_ride < 17.94614) %>% 
ggplot() + 
  aes(as.factor(year), as.numeric(time_ride))+
  geom_boxplot() + 
  labs(x = "\nYear",
     y = "time_ride",
     title = "Distribution of riding time in 2018(90%)",
     subtitle = "Data from citibike NYC\n")

nyc_bikes_short %>% 
  ggplot()+
  aes(as.factor(year), as.numeric(time_ride)) %>% 
  geom_boxplot()+
  labs(x = "\nYear",
     y = "time_ride",
     title = "Distribution of riding time in 2018(100%)",
     subtitle = "Data from citiBike NYC\n")

 #the outliers are too crazy so I only included the 90% of the data to give 
#a brief idea of how the ride time is like in the year of 2018. 

bike_month <- nyc_bikes_short%>% 
  index_by(month) %>% 
  summarise(ride_time_mean = mean(time_ride, na.rm = TRUE))

bike_month

bike_month %>% 
  ggplot(aes(month, as.numeric(ride_time_mean)))+
  geom_point()+
  geom_line(group = 1)+
  labs(
    x="Month",
    y = "Average Riding Time",
    title = "Average riding time for each month",
    subtitle = "Data from 2018 citibike NYC\n"
  )

bike_wday <- nyc_bikes_short%>% 
  index_by(wday) %>% 
  summarise(ride_time_mean = mean(time_ride, na.rm = TRUE))

bike_wday

 bike_wday %>% 
  ggplot(aes(wday, ride_time_mean))+
  geom_point()+
  geom_line(group = 1)+
   labs(
    x="Weekdays",
    y = "Average Riding Time",
    title = "Average riding time for each day of week",
    subtitle = "Data from 2018 citibike NYC\n"
  )

bike_day <- nyc_bikes_short%>% 
  index_by(day) %>% 
  summarise(ride_time_mean = mean(time_ride, na.rm = TRUE))

bike_day

bike_day %>% 
  ggplot(aes(day, as.numeric(ride_time_mean)))+
  geom_line()+
  coord_trans(y = "log10")+
  labs(
    x="Days",
    y = "Average Riding Time(log_scale)",
    title = "Average riding time for each day",
    subtitle = "Data from 2018 citibike NYC\n"
  )

week

bike_week <- nyc_bikes_short%>% 
  index_by(week) %>% 
  summarise(ride_time_mean = mean(time_ride, na.rm = TRUE))

bike_week

bike_week %>% 
  ggplot(aes(week, as.numeric(ride_time_mean)))+
  geom_point()+
  geom_line(group = 1)+
   scale_x_continuous(breaks = seq(0,52,5))+
  coord_trans(y = "log10")+
  labs(
    x="Weeks in the year",
    y = "Average Riding Time(log scale)",
    title = "Average riding time for each week",
    subtitle = "Data from 2018 citibike NYC\n"
  )

#42 and 46 something to check 
#OCT 15 -21
#nov 12 -18

##gender-year

 nyc_bikes_short %>% 
  mutate(time_ride = as.numeric(time_ride)) %>% 
  filter(time_ride < 17.94614) %>% 
ggplot() + 
  aes(as.factor(year), as.numeric(time_ride))+
  geom_boxplot(aes(col = gender)) + 
  labs(x = "\nYear",
     y = "time_ride",
     title = "Distribution of ride time in 2018(90%)",
     subtitle = "for each gender\n")

gender month

nyc_bikes_short %>% 
  group_by(gender) %>% 
  index_by(month) %>% 
  summarise(mean_time_ride = mean(time_ride)) %>% 
  ggplot(aes(month, as.numeric(mean_time_ride)))+
  facet_grid(~gender)+
  geom_point(aes(col = gender))+
  geom_line(group = 1)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

  labs(
    x="Month",
    y = "Average Riding Time",
    title = "Average riding time for each month",
    subtitle = "for each gender NYC\n"
  )

$x
[1] "Month"

$y
[1] "Average Riding Time"

$title
[1] "Average riding time for each month"

$subtitle
[1] "for each gender NYC\n"

attr(,"class")
[1] "labels"

gender week

nyc_bikes_short %>% 
  group_by(gender) %>% 
  index_by(week) %>% 
  summarise(mean_time_ride = mean(time_ride)) %>% 
  ggplot(aes(week, as.numeric(mean_time_ride)))+
  facet_wrap(~gender,ncol =1, scales = "free_y")+
  geom_point(aes(col = gender))+
  geom_line(group = 1)+
 scale_x_continuous(breaks = seq(0,52,5))+
  labs(
    x="Week",
    y = "Average Riding Time",
    title = "Average riding time for each month",
    subtitle = "for each gender NYC\n"
  )

gender weekdays

nyc_bikes_short %>% 
  group_by(gender) %>% 
  index_by(wday) %>% 
  summarise(mean_time_ride = mean(time_ride)) %>% 
  ggplot(aes(wday, as.numeric(mean_time_ride)))+
  facet_wrap(~gender,ncol =1, scales = "free_y")+
  geom_point(aes(col = gender))+
  geom_line(aes(col = gender),group = 1)+
  labs(
    x="Weekday",
    y = "Average Riding Time",
    title = "Average riding time for each weekdays",
    subtitle = "for each gender NYC\n"
  )

nyc_bikes_short <- nyc_bikes_short %>%  mutate(
  age_group = case_when(age < 18 ~ "Under 18",
                        age < 30 ~"18 to 30",
                        age < 60 ~"30 to 60",
                        TRUE ~"60 and above")
)

age_year

 nyc_bikes_short %>% 
  mutate(time_ride = as.numeric(time_ride)) %>% 
  filter(time_ride < 17.94614) %>% 
ggplot() + 
  aes(as.factor(age_group), as.numeric(time_ride))+
  geom_boxplot(aes(col = age_group)) + 
  labs(x = "\nAge Group",
     y = "Riding Time",
     col = "Age Group",
     title = "Distribution of ride time in 2018",
     subtitle = "with 90% of the data\n")

age month

nyc_bikes_short %>% 
  group_by(age_group) %>% 
  index_by(month) %>% 
  summarise(mean_time_ride = mean(time_ride)) %>% 
  ggplot(aes(month, as.numeric(mean_time_ride)))+
  facet_wrap(~age_group, ncol = 1, scales = "free_y")+
  geom_point(aes(col = age_group))+
  geom_line(group = 1)+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

  labs(
    x="Month",
    y = "Average Riding Time",
    title = "Average riding time for each month",
    subtitle = "for each age_group NYC\n"
  )

$x
[1] "Month"

$y
[1] "Average Riding Time"

$title
[1] "Average riding time for each month"

$subtitle
[1] "for each age_group NYC\n"

attr(,"class")
[1] "labels"

age weekday

nyc_bikes_short %>% 
  group_by(age_group) %>% 
  index_by(wday) %>% 
  summarise(mean_time_ride = mean(time_ride)) %>% 
  ggplot(aes(wday, as.numeric(mean_time_ride)))+
  facet_wrap(~age_group,ncol =1, scales = "free_y")+
  geom_point(aes(col = age_group), size = 2)+
  geom_line(aes(col = age_group),group = 1)+
  labs(
    x="Weekday",
    y = "Average Riding Time",
    col = "Age Group",
    title = "Average riding time for each weekdays",
    subtitle = "for each age group \n"
  )

nyc_bikes_short %>% 
  group_by(age_group) %>% 
  index_by(week) %>% 
  summarise(mean_time_ride = mean(time_ride)) %>% 
  ggplot(aes(week, as.numeric(mean_time_ride)))+
  facet_wrap(~age_group,ncol =1, scales = "free_y")+
  geom_point(aes(col = age_group))+
  geom_line(group = 1)+
 scale_x_continuous(breaks = seq(0,52,5))+
  labs(
    x="Week",
    y = "Average Riding Time",
    col = "Age Group",
    title = "Average riding time for each week",
    subtitle = "for each age group\n"
  )

library(leaflet)

Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

nyc_bikes_df %>% 
  filter(bike_id == "26301") %>% 
leaflet() %>% 
  addTiles() %>% 
  addMarkers(
    lng = ~start_long,
    lat = ~start_lat,
    clusterOptions = markerClusterOptions()
  )

nyc_bikes_df %>% 
  filter(bike_id == "29477") %>% 
leaflet() %>% 
  addTiles() %>% 
  addMarkers(
    lng = ~start_long,
    lat = ~start_lat,
    clusterOptions = markerClusterOptions()
  )

 nyc_bikes_df %>% 
  mutate(week = week(start_time)) %>% 
  filter(week == 46) %>% 
  leaflet() %>% 
  addTiles() %>% 
  addMarkers(
    lng = ~start_long,
    lat = ~start_lat,
    clusterOptions = markerClusterOptions()
  )

 nyc_bikes_df %>% 
  mutate(week = week(start_time)) %>% 
  filter(week == 42) %>% 
  leaflet() %>% 
  addTiles() %>% 
  addMarkers(
    lng = ~end_long,
    lat = ~end_lat,
    clusterOptions = markerClusterOptions()
  )

near to stations

nyc_bikes_short %>% 
  group_by(day) %>% 
  summarise(mean = mean(time_ride)) %>% 
  arrange(desc(mean))

Warning: Current temporal ordering may yield unexpected results.
ℹ Suggest to sort by `day`, `start_time` first.

We’re mid-way through Women’s Bike Month! october Did you know only a quarter of all bike trips in the U.S. are taken by women? At Citi Bike, we’re dedicated to changing this. This month we’re giving all new riders their first trip free using code GIRLUP18, and donating $1 from each of these rides to Girl Up’s SchoolCycle program to help provide bikes to girls around the world so they can safely access education. Join us in encouraging more ladies to get on bikes and give back to a great cause while doing it.

 nyc_bikes_df %>% 
  mutate(week = week(start_time)) %>% 
  filter(week == 4) %>% 
  leaflet() %>% 
  addTiles() %>% 
  addMarkers(
    lng = ~end_long,
    lat = ~end_lat,
    clusterOptions = markerClusterOptions()
  )

```